home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / PASCALL / TEMPJUNK / NTC.PAS < prev    next >
Pascal/Delphi Source File  |  1992-10-23  |  4KB  |  153 lines
  1. { copyright - october 1992 Fernando Padilla
  2.  This is a phone company bill printing program....
  3.   It calculates the gross, net, and taxed amounts and prints them out, if
  4.   the data is valid---Page 93, problem #17}
  5.  
  6. program NTC;
  7. uses
  8.      crt;
  9. const
  10.      taxrate=0.04;
  11.      rate=0.4;
  12. type
  13.      customer=record
  14.           phonenumber:string[8];
  15.           starttime:integer;
  16.           length:integer;
  17.           gross:real;
  18.           net:real;
  19.           tax:real;
  20.      end;
  21.  
  22. procedure input(var inputfile:text; var whiner:customer);
  23. begin
  24.      with whiner do
  25.      begin
  26.           readln(inputfile,phonenumber);
  27.           readln(inputfile,starttime);
  28.           readln(inputfile,length);
  29.      end;
  30. end;
  31.  
  32. function testdata(whiner:customer):boolean;
  33. var
  34.      arm,len:boolean;
  35. begin
  36.      testdata:=true;
  37.      with whiner do
  38.      begin
  39.           if (length<=1440) and (length>=1) then len:=true
  40.           else len:=false;
  41.           if (starttime<=2400) and (length>=1) then arm:=true
  42.           else arm:=false;
  43.           if not arm or not len then testdata:=false;
  44.      end;
  45. end;
  46.  
  47. function gross(length:integer):real;
  48. begin
  49.      gross:=length*rate;
  50. end;
  51.  
  52. function net(whiner:customer):real;
  53. begin
  54.      case (whiner.starttime) of
  55.           0800..1799: net:=(whiner.gross);
  56.      else net:=(whiner.gross)*0.5;
  57.      end;
  58.      if (whiner.length)>=60 then net:=(whiner.gross)*0.85;
  59. end;
  60.  
  61. function returnaftertax(whiner:customer):real;
  62. begin
  63.      returnaftertax:=(whiner.net)*(1+taxrate);
  64. end;
  65.  
  66. procedure processing(var whiner:customer);
  67. begin
  68.      whiner.gross:=gross(whiner.length);
  69.      whiner.net:=net(whiner);
  70.      whiner.tax:=returnaftertax(whiner);
  71. end;
  72.  
  73. procedure output(whiner:customer);
  74. var
  75.      i:integer;
  76. begin
  77.      clrscr;
  78.      with whiner do
  79.      begin
  80.           gotoxy(25,1);
  81.                write('Customer phonenumber: ',phonenumber);
  82.           gotoxy(27,2);
  83.                write('The following call bill:');
  84.           gotoxy(1,4);
  85.                write('Starting Time: ',starttime);
  86.           gotoxy(40,4);
  87.                write('Length of call: ',length);
  88.           gotoxy(1,6);
  89.                write('Raw');
  90.           gotoxy(20,6);
  91.                write('Discounted');
  92.           gotoxy(40,6);
  93.                write('Tax included');
  94.           for i:=1 to 18 do
  95.           begin
  96.                gotoxy(i,7);
  97.                     write('-');
  98.                gotoxy(i+20,7);
  99.                     write('-');
  100.                gotoxy(i+40,7);
  101.                     write('-');
  102.           end;
  103.           gotoxy(1,8);
  104.                write('$',gross:17:2);
  105.           gotoxy(20,8);
  106.                write('$',net:17:2);
  107.           gotoxy(40,8);
  108.                write('$',tax:17:2);
  109.           readln;
  110.      end;
  111. end;
  112.  
  113. procedure errorfound(whiner:customer);
  114. begin
  115.      clrscr;
  116.      with whiner do
  117.      begin
  118.           gotoxy(25,1);
  119.                write('Customer phonenumber: ',phonenumber);
  120.      end;
  121.      textattr:=textattr+blink;
  122.      gotoxy(1,4);
  123.           write('THIS Customer PHONE CALL record is invalid');
  124.      gotoxy(1,5);
  125.           write('     PLEASE do something do something about it!');
  126.      textattr:=textattr-blink;
  127.      readln;
  128. end;
  129.  
  130. procedure runcustomer;
  131. var
  132.      user:customer;
  133.      inputfile:text;
  134. begin
  135.      assign(inputfile,'a:\ntc.dat');
  136.      reset(inputfile);
  137.      while not eof(inputfile) do
  138.      begin
  139.           input(inputfile,user);
  140.           if testdata(user) then begin
  141.                processing(user);
  142.                output(user);
  143.           end
  144.           else begin
  145.                errorfound(user);
  146.           end;
  147.      end;
  148.      close(inputfile);
  149. end;
  150.  
  151. begin {NTC}
  152.      runcustomer;
  153. end.